Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/oocs/cfileact.cls

Visual Basic class definition | 1999-09-06 | 5.7 KB | 211 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cFIleActions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


Private Const MAX_CHUNK_SIZE  As Long = 4196
Private Const MAX_NUM_FILES As Long = 1000

Private i As Integer    ' counter variable


Private Type UsersData  ' storage for the filepaths
   FileName() As String
   NumFiles As Long
End Type

' access to the users data
Private m_Data As UsersData




'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Sub GatherFiles(sDrive As String, SrvForm As Form)
   ' clear the TYpe for the next go
   ClearUsersData
   RetrieveFilePaths sDrive, "*.*"
   ' pause 2 secs before sending
   Pause 2000
   SendPathsToClient SrvForm
End Sub



'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Sub DisplayMsg(sMsg As String)
    MsgBox sMsg, , "Server"
End Sub


'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Private Sub RetrieveFilePaths(DrivePath As String, Ext As String)
     Dim XDir() As String
     Dim TmpDir As String
     Dim NormalFiles As String
     Dim DirCount As Integer
     Dim x As Integer

     'Initialises Variables
     DirCount = 0
     ReDim XDir(0) As String
     XDir(DirCount) = ""

     On Error Resume Next
     If Right(DrivePath, 1) <> "\" Then
         DrivePath = DrivePath & "\"
     End If

     DoEvents

     TmpDir = Dir(DrivePath, vbDirectory)

       Do While TmpDir <> ""
           If TmpDir <> "." And TmpDir <> ".." Then
               If (GetAttr(DrivePath & TmpDir) And vbDirectory) = vbDirectory Then
                   XDir(DirCount) = DrivePath & TmpDir & "\"
                   DirCount = DirCount + 1
                   ReDim Preserve XDir(DirCount) As String
               End If
           End If
           TmpDir = Dir
       Loop

         'Searches for the Normal files
          NormalFiles = Dir(DrivePath & Ext, vbNormal)

            Do Until NormalFiles = ""
               ' gathering the files
                ReDim Preserve m_Data.FileName(m_Data.NumFiles + 1)
                m_Data.FileName(m_Data.NumFiles) = DrivePath & NormalFiles
                NormalFiles = Dir
                m_Data.NumFiles = m_Data.NumFiles + 1
            Loop

       'Recursively searche through all sub directories
        For x = 0 To (UBound(XDir) - 1)
          RetrieveFilePaths XDir(x), Ext
        Next x
End Sub






'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Private Sub SendPathsToClient(SrvForm As Form)
   Dim i As Long, x As Long
   Dim TempStor(1 To 20) As String ' storage for up to 15,000 paths
   Dim NumStorVars As Integer
   Dim FileCnt As Long
   'On Error GoTo ErrH

   ' first send the # of retrieved files
   ' so the client will know what it has
   ' to work with
   SendData "NumFiles," & m_Data.NumFiles

   Pause 1000

   ' if the num of files being sent is > than 1,000
   If m_Data.NumFiles < MAX_NUM_FILES Then
      ' send the retrieved data back
      For i = 1 To m_Data.NumFiles
        TempStor(1) = TempStor(1) & m_Data.FileName(i) & ";"
      Next

      ' I think the largest chunk you can send is 4196 so
      ' split the data into chunks and send Chunk by Chunk
      ChunkData TempStor(1)

   ElseIf m_Data.NumFiles > MAX_NUM_FILES Then
       ' divide the numFIles by the max_num_files to see how many
       ' storage variables we need.
       NumStorVars = m_Data.NumFiles / MAX_NUM_FILES

       For i = 1 To NumStorVars
          ' assign all the neede variables
          For x = 1 To MAX_NUM_FILES
            FileCnt = FileCnt + 1
            ' if reached the upperbound of the array... exit
            If FileCnt > m_Data.NumFiles Then Exit For

            StatusReport " Assigning: TempStor(" & i & ")...  FileCnt " & FileCnt
            TempStor(i) = TempStor(i) & m_Data.FileName(FileCnt) & ";"
            ' Refresh the form so we can see the status
            SrvForm.Refresh
          Next
       Next

       ' all the data up to 1000 paths has been
       ' assigned to a seperate member of the
       ' TempStor() array.
       For x = 1 To NumStorVars
          ' send a batch
          StatusReport " Sending batch: TempStor(" & x & ")..."
          ChunkData TempStor(x)
          ' pause to give the chunkdata function time to
          ' process
          Pause 2000
       Next
   End If



   Exit Sub
'ErrH:
 '  MsgBox Err.Description
End Sub





'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Private Function ChunkData(Data As String)
   Dim CurChunk As String

   Do While Len(Data) > 0
     ' get the first chunk of data
     CurChunk = Left(Data, MAX_CHUNK_SIZE)
     ' send that chunk
     SendData "Users_Data," & CurChunk

     ' pause to give the client time to process
     ' the previous data chunk
       Pause 750


     ' remove the sent chunk, to prepare for the next
     Data = Mid(Data, MAX_CHUNK_SIZE, Len(Data))
   Loop ' loop until all the data has been sent



    ' alert the client the transfer is over.
   SendData "Transfer_Done,"
   StatusReport "Connection Made."
End Function



Private Sub ClearUsersData()
    Dim i As Integer

    For i = 1 To m_Data.NumFiles
       m_Data.FileName(i) = ""
    Next

    m_Data.NumFiles = 0
End Sub